home *** CD-ROM | disk | FTP | other *** search
/ Experimental BBS Explossion 3 / Experimental BBS Explossion III.iso / pascal / tvtool2.zip / TVINPUT.PAS < prev    next >
Pascal/Delphi Source File  |  1993-07-20  |  49KB  |  430 lines
  1. {*
  2. *
  3. *   Copyright (c) 1992,93 by Richard W. Hansen
  4. *
  5. *   This source code will compile.
  6. *   Full source code available to registered users.
  7. *
  8. *}
  9. (* This file was mangled by Mangler 1.10 (c) Copyright 1993 by Berend de Boer *)
  10.  UNIT TVINPUT ;{$B+} {$X+} {$V-} {$N+} {$I TVDEFS.INC} INTERFACE USES DOS , APP , DIALOGS , DRIVERS , OBJECTS , VIEWS ,
  11. MSGBOX , TVCONST , TVDIALOG , TVSTRING , TVTYPE ;PROCEDURE SETDATEDEFAULTS ;CONST DFREQUIRED =$0001 ;DFRJUSTIFY =$0002 ;
  12. DFLJUSTIFY =$0004 ;DFTRIM =$0008 ;DFHIDE =$0010 ;DFDEFAULTS =$0020 ;CONST HIDECHAR :CHAR ='*';DECIMALPT ='.';
  13. LEFT =TRUE ;RIGHT =FALSE ;CONST ANYCHAR ='X';FORCEUP ='U';FORCELO ='L';ALPHAONLY ='a';UPPERALPHA ='u';LOWERALPHA ='l';
  14. NUMBERONLY ='#';DIGITONLY ='9';HEXONLY ='&';DATEONLY ='@';CONST EDITMASKCHARS :TCHARSET =[ ANYCHAR , FORCEUP , FORCELO ,
  15. ALPHAONLY , UPPERALPHA , LOWERALPHA , NUMBERONLY , DIGITONLY , HEXONLY , DATEONLY ] ;CONST ANYCHARSET :TCHARSET =[ #32..
  16. #255] ;CONST ALPHAONLYSET :TCHARSET =[ '0'.. '9', 'A'.. 'Z', 'a'.. 'z', ' '] ;CONST DIGITONLYSET :TCHARSET =[ '0'.. '9']
  17. ;CONST NUMBERONLYSET :TCHARSET =[ '0'.. '9', '-'] ;CONST HEXONLYSET :TCHARSET =[ '0'.. '9', 'A'.. 'F', 'a'.. 'f', '$'] ;
  18. CONST DATEONLYSET :TCHARSET =[ '0'.. '9', ' '] ;CONST DEFAULTDAY :WORD =0 ;DEFAULTYEAR :WORD =0 ;DEFAULTMONTH :WORD =0 ;
  19. TYPE PBXEDITLINE =^TBXEDITLINE ;TBXEDITLINE =OBJECT (TINPUTLINE)PADCHAR :CHAR ;XPOS :BYTE ;FIRST :BYTE ;MASK :PSTRING ;
  20. ID :WORD ;LLABEL :PLABEL ;EDITFLAGS :WORD ;CONSTRUCTOR INIT (VAR BOUNDS :TRECT ;AMASK :STRING );CONSTRUCTOR LOAD
  21. (VAR S :TSTREAM );DESTRUCTOR DONE ;VIRTUAL;PROCEDURE ADDLABEL (ALABEL :PLABEL );FUNCTION DATASIZE :WORD ;VIRTUAL;
  22. PROCEDURE DRAW ;VIRTUAL;FUNCTION EDITTOMASKPOS (POS :INTEGER ):INTEGER ;FUNCTION EMPTY :BOOLEAN ;VIRTUAL;
  23. PROCEDURE GETDATA (VAR REC );VIRTUAL;FUNCTION GETFIELDNAME :STRING ;VIRTUAL;FUNCTION GETID :WORD ;VIRTUAL;
  24. PROCEDURE HANDLEEVENT (VAR EVENT :TEVENT );VIRTUAL;FUNCTION HOMEPOS :INTEGER ;VIRTUAL;PROCEDURE INSERTCHAR (CH :CHAR );
  25. VIRTUAL;FUNCTION MASKTOEDITPOS (POS :INTEGER ):INTEGER ;PROCEDURE LOCK ;PROCEDURE MERGE (VAR ST :STRING ;
  26. JUSTIFY :BOOLEAN );VIRTUAL;FUNCTION NEXTPOS (POS :INTEGER ):INTEGER ;VIRTUAL;FUNCTION PREVPOS (POS :INTEGER ):INTEGER ;
  27. VIRTUAL;FUNCTION REMOVE (CONST ST :STRING ):STRING ;PROCEDURE SETDATA (VAR REC );VIRTUAL;PROCEDURE SETEDITFLAG
  28. (AFLAG :WORD ;ENABLE :BOOLEAN );VIRTUAL;PROCEDURE SETID (AFIELDID :WORD );PROCEDURE SETSTATE (ASTATE :WORD ;
  29. ENABLE :BOOLEAN );VIRTUAL;PROCEDURE STORE (VAR S :TSTREAM );PROCEDURE UNLOCK ;FUNCTION VALID (COMMAND :WORD ):BOOLEAN ;
  30. VIRTUAL;PRIVATE FUNCTION CANSCROLL (SCROLLLEFT :BOOLEAN ):BOOLEAN ;PROCEDURE DELETEMARKED ;PROCEDURE SELECTALL
  31. (ENABLE :BOOLEAN );END ;PBXDATEEDIT =^TBXDATEEDIT ;TBXDATEEDIT =OBJECT (TBXEDITLINE)DATE :PBXDATE ;DATEPIC :TBXDATEST ;
  32. CONSTRUCTOR INIT (VAR BOUNDS :TRECT ;ADATEPIC :TBXDATEST );CONSTRUCTOR LOAD (VAR S :TSTREAM );DESTRUCTOR DONE ;VIRTUAL;
  33. FUNCTION DATASIZE :WORD ;VIRTUAL;PROCEDURE GETDATA (VAR REC );VIRTUAL;PROCEDURE SETDATA (VAR REC );VIRTUAL;
  34. PROCEDURE STORE (VAR S :TSTREAM );FUNCTION VALID (COMMAND :WORD ):BOOLEAN ;VIRTUAL;END ;
  35. PBXNUMERICEDIT =^TBXNUMERICEDIT ;TBXNUMERICEDIT =OBJECT (TBXEDITLINE)ERRCODE :INTEGER ;PROCEDURE HANDLEEVENT
  36. (VAR EVENT :TEVENT );VIRTUAL;FUNCTION OUTOFRANGE :BOOLEAN ;VIRTUAL;FUNCTION OUTOFRANGEMSG :STRING ;VIRTUAL;
  37. FUNCTION VALID (COMMAND :WORD ):BOOLEAN ;VIRTUAL;END ;PBXLONGEDIT =^TBXLONGEDIT ;
  38. TBXLONGEDIT =OBJECT (TBXNUMERICEDIT)MIN :LONGINT ;MAX :LONGINT ;CONSTRUCTOR INIT (VAR BOUNDS :TRECT ;CONST AMASK :STRING
  39. ;AMIN :LONGINT ;AMAX :LONGINT );CONSTRUCTOR LOAD (VAR S :TSTREAM );FUNCTION DATASIZE :WORD ;VIRTUAL;PROCEDURE GETDATA
  40. (VAR REC );VIRTUAL;FUNCTION OUTOFRANGE :BOOLEAN ;VIRTUAL;FUNCTION OUTOFRANGEMSG :STRING ;VIRTUAL;PROCEDURE SETDATA
  41. (VAR REC );VIRTUAL;PROCEDURE STORE (VAR S :TSTREAM );END ;PBXHEXEDIT =^TBXHEXEDIT ;
  42. TBXHEXEDIT =OBJECT (TBXLONGEDIT)FUNCTION OUTOFRANGEMSG :STRING ;VIRTUAL;PROCEDURE SETDATA (VAR REC );VIRTUAL;END ;
  43. PBXINTEGEREDIT =^TBXINTEGEREDIT ;TBXINTEGEREDIT =OBJECT (TBXLONGEDIT)CONSTRUCTOR INIT (VAR BOUNDS :TRECT ;
  44. CONST AMASK :STRING ;AMIN :INTEGER ;AMAX :INTEGER );FUNCTION DATASIZE :WORD ;VIRTUAL;PROCEDURE GETDATA (VAR REC );
  45. VIRTUAL;PROCEDURE SETDATA (VAR REC );VIRTUAL;END ;PBXWORDEDIT =^TBXWORDEDIT ;
  46. TBXWORDEDIT =OBJECT (TBXLONGEDIT)CONSTRUCTOR INIT (VAR BOUNDS :TRECT ;CONST AMASK :STRING ;AMIN :WORD ;AMAX :WORD );
  47. FUNCTION DATASIZE :WORD ;VIRTUAL;PROCEDURE GETDATA (VAR REC );VIRTUAL;PROCEDURE SETDATA (VAR REC );VIRTUAL;END ;
  48. PBXBYTEEDIT =^TBXBYTEEDIT ;TBXBYTEEDIT =OBJECT (TBXLONGEDIT)CONSTRUCTOR INIT (VAR BOUNDS :TRECT ;CONST AMASK :STRING ;
  49. AMIN :BYTE ;AMAX :BYTE );FUNCTION DATASIZE :WORD ;VIRTUAL;PROCEDURE GETDATA (VAR REC );VIRTUAL;PROCEDURE SETDATA
  50. (VAR REC );VIRTUAL;END ;PBXFLOATEDIT =^TBXFLOATEDIT ;TBXFLOATEDIT =OBJECT (TBXNUMERICEDIT)DP :BYTE ;CONSTRUCTOR INIT
  51. (VAR BOUNDS :TRECT ;CONST AMASK :STRING );CONSTRUCTOR LOAD (VAR S :TSTREAM );PROCEDURE HANDLEEVENT (VAR EVENT :TEVENT );
  52. VIRTUAL;PROCEDURE STORE (VAR S :TSTREAM );END ;{$IFOPT N+} PBXDOUBLEEDIT =^TBXDOUBLEEDIT ;
  53. TBXDOUBLEEDIT =OBJECT (TBXFLOATEDIT)MIN :DOUBLE ;MAX :DOUBLE ;CONSTRUCTOR INIT (VAR BOUNDS :TRECT ;CONST AMASK :STRING ;
  54. AMIN :DOUBLE ;AMAX :DOUBLE );CONSTRUCTOR LOAD (VAR S :TSTREAM );FUNCTION DATASIZE :WORD ;VIRTUAL;PROCEDURE GETDATA
  55. (VAR REC );VIRTUAL;FUNCTION OUTOFRANGE :BOOLEAN ;VIRTUAL;FUNCTION OUTOFRANGEMSG :STRING ;VIRTUAL;PROCEDURE SETDATA
  56. (VAR REC );VIRTUAL;PROCEDURE STORE (VAR S :TSTREAM );END ;{$ENDIF} PBXREALEDIT =^TBXREALEDIT ;
  57. TBXREALEDIT =OBJECT (TBXFLOATEDIT)MIN :REAL ;MAX :REAL ;CONSTRUCTOR INIT (VAR BOUNDS :TRECT ;CONST AMASK :STRING ;
  58. AMIN :REAL ;AMAX :REAL );CONSTRUCTOR LOAD (VAR S :TSTREAM );FUNCTION DATASIZE :WORD ;VIRTUAL;PROCEDURE GETDATA
  59. (VAR REC );VIRTUAL;FUNCTION OUTOFRANGE :BOOLEAN ;VIRTUAL;FUNCTION OUTOFRANGEMSG :STRING ;VIRTUAL;PROCEDURE SETDATA
  60. (VAR REC );VIRTUAL;PROCEDURE STORE (VAR S :TSTREAM );END ;PBXCHECKBOXES =^TBXCHECKBOXES ;
  61. TBXCHECKBOXES =OBJECT (TCHECKBOXES)ID :WORD ;LLABEL :PLABEL ;EDITFLAGS :WORD ;CONSTRUCTOR INIT (VAR BOUNDS :TRECT ;
  62. ASTRINGS :PSITEM );CONSTRUCTOR LOAD (VAR S :TSTREAM );PROCEDURE ADDLABEL (ALABEL :PLABEL );FUNCTION EMPTY :BOOLEAN ;
  63. VIRTUAL;FUNCTION GETID :WORD ;FUNCTION GETFIELDNAME :STRING ;VIRTUAL;PROCEDURE HANDLEEVENT (VAR EVENT :TEVENT );VIRTUAL;
  64. PROCEDURE LOCK ;PROCEDURE SETEDITFLAG (AFLAG :WORD ;ENABLE :BOOLEAN );VIRTUAL;PROCEDURE SETID (AFIELDID :WORD );
  65. PROCEDURE SETSTATE (ASTATE :WORD ;ENABLE :BOOLEAN );VIRTUAL;PROCEDURE STORE (VAR S :TSTREAM );PROCEDURE UNLOCK ;
  66. FUNCTION VALID (COMMAND :WORD ):BOOLEAN ;VIRTUAL;END ;PBXRADIOBUTTONS =^TBXRADIOBUTTONS ;
  67. TBXRADIOBUTTONS =OBJECT (TRADIOBUTTONS)ID :WORD ;LLABEL :PLABEL ;EDITFLAGS :WORD ;CONSTRUCTOR INIT (VAR BOUNDS :TRECT ;
  68. ASTRINGS :PSITEM );CONSTRUCTOR LOAD (VAR S :TSTREAM );PROCEDURE ADDLABEL (ALABEL :PLABEL );FUNCTION GETFIELDNAME :STRING
  69. ;VIRTUAL;FUNCTION GETID :WORD ;PROCEDURE HANDLEEVENT (VAR EVENT :TEVENT );VIRTUAL;PROCEDURE LOCK ;PROCEDURE SETEDITFLAG
  70. (AFLAG :WORD ;ENABLE :BOOLEAN );VIRTUAL;PROCEDURE SETID (AFIELDID :WORD );PROCEDURE SETSTATE (ASTATE :WORD ;
  71. ENABLE :BOOLEAN );VIRTUAL;PROCEDURE STORE (VAR S :TSTREAM );PROCEDURE UNLOCK ;END ;PBXSLIDER =^TBXSLIDER ;
  72. TBXSLIDER =OBJECT (TGROUP)SCROLLBAR :PSCROLLBAR ;ID :WORD ;LLABEL :PLABEL ;EDITFLAGS :WORD ;CONSTRUCTOR INIT
  73. (VAR BOUNDS :TRECT ;AMIN :INTEGER ;AMAX :INTEGER ;CONST AMINLABEL :STRING ;CONST AMAXLABEL :STRING );CONSTRUCTOR LOAD
  74. (VAR S :TSTREAM );PROCEDURE ADDLABEL (ALABEL :PLABEL );PROCEDURE GETDATA (VAR REC );VIRTUAL;FUNCTION GETID :WORD ;
  75. FUNCTION GETFIELDNAME :STRING ;VIRTUAL;PROCEDURE HANDLEEVENT (VAR EVENT :TEVENT );VIRTUAL;PROCEDURE LOCK ;
  76. PROCEDURE SETDATA (VAR REC );VIRTUAL;PROCEDURE SETEDITFLAG (AFLAG :WORD ;ENABLE :BOOLEAN );VIRTUAL;PROCEDURE SETID
  77. (AFIELDID :WORD );PROCEDURE SETSTATE (ASTATE :WORD ;ENABLE :BOOLEAN );VIRTUAL;PROCEDURE STORE (VAR S :TSTREAM );
  78. PROCEDURE UNLOCK ;END ;PBXSPINEDIT =^TBXSPINEDIT ;TBXSPINCHARS =ARRAY [ 1 .. 2 ]  OF CHAR ;PBXSPINBAR =^TBXSPINBAR ;
  79. TBXSPINBAR =OBJECT (TSCROLLBAR)CHARS :TBXSPINCHARS ;SPINEDIT :PBXSPINEDIT ;CONSTRUCTOR INIT (VAR BOUNDS :TRECT );
  80. CONSTRUCTOR LOAD (VAR S :TSTREAM );PROCEDURE DRAW ;VIRTUAL;PROCEDURE HANDLEEVENT (VAR EVENT :TEVENT );VIRTUAL;
  81. PROCEDURE STORE (VAR S :TSTREAM );END ;TBXSPINEDIT =OBJECT (TBXINTEGEREDIT)SPINBAR :PBXSPINBAR ;CONSTRUCTOR INIT
  82. (VAR BOUNDS :TRECT ;CONST AMASK :STRING ;ASPINBAR :PBXSPINBAR );CONSTRUCTOR LOAD (VAR S :TSTREAM );PROCEDURE HANDLEEVENT
  83. (VAR EVENT :TEVENT );VIRTUAL;PROCEDURE SETDATA (VAR REC );VIRTUAL;PROCEDURE STORE (VAR S :TSTREAM );PROCEDURE SETSTATE
  84. (ASTATE :WORD ;ENABLE :BOOLEAN );VIRTUAL;FUNCTION VALID (COMMAND :WORD ):BOOLEAN ;VIRTUAL;END ;
  85. PBXENTRYDIALOG =^TBXENTRYDIALOG ;TBXENTRYDIALOG =OBJECT (TDIALOG)NEXTID :WORD ;CONSTRUCTOR INIT (VAR BOUNDS :TRECT ;
  86. ATITLE :TTITLESTR );CONSTRUCTOR LOAD (VAR S :TSTREAM );FUNCTION FINDFIELD (ID :WORD ):POINTER ;PROCEDURE HANDLEEVENT
  87. (VAR EVENT :TEVENT );VIRTUAL;PROCEDURE INSERT (P :PVIEW );VIRTUAL;PROCEDURE LOCKFIELD (ID :WORD ;ENABLE :BOOLEAN );
  88. PROCEDURE STORE (VAR S :TSTREAM );END ;PROCEDURE REGISTERTVINPUT ;CONST RBXEDITLINE :TSTREAMREC =(OBJTYPE :5300 ;
  89. VMTLINK :OFS (TYPEOF (TBXEDITLINE )^);LOAD :@ TBXEDITLINE . LOAD ;STORE :@ TBXEDITLINE . STORE );
  90. CONST RBXDATEEDIT :TSTREAMREC =(OBJTYPE :5301 ;VMTLINK :OFS (TYPEOF (TBXDATEEDIT )^);LOAD :@ TBXDATEEDIT . LOAD ;
  91. STORE :@ TBXDATEEDIT . STORE );CONST RBXLONGEDIT :TSTREAMREC =(OBJTYPE :5302 ;VMTLINK :OFS (TYPEOF (TBXLONGEDIT )^);
  92. LOAD :@ TBXLONGEDIT . LOAD ;STORE :@ TBXLONGEDIT . STORE );CONST RBXHEXEDIT :TSTREAMREC =(OBJTYPE :5303 ;
  93. VMTLINK :OFS (TYPEOF (TBXHEXEDIT )^);LOAD :@ TBXHEXEDIT . LOAD ;STORE :@ TBXHEXEDIT . STORE );
  94. CONST RBXINTEGEREDIT :TSTREAMREC =(OBJTYPE :5304 ;VMTLINK :OFS (TYPEOF (TBXINTEGEREDIT )^);LOAD :@ TBXINTEGEREDIT .
  95. LOAD ;STORE :@ TBXINTEGEREDIT . STORE );CONST RBXWORDEDIT :TSTREAMREC =(OBJTYPE :5305 ;
  96. VMTLINK :OFS (TYPEOF (TBXWORDEDIT )^);LOAD :@ TBXWORDEDIT . LOAD ;STORE :@ TBXWORDEDIT . STORE );
  97. CONST RBXBYTEEDIT :TSTREAMREC =(OBJTYPE :5306 ;VMTLINK :OFS (TYPEOF (TBXBYTEEDIT )^);LOAD :@ TBXBYTEEDIT . LOAD ;
  98. STORE :@ TBXBYTEEDIT . STORE );{$IFOPT N+} CONST RBXDOUBLEEDIT :TSTREAMREC =(OBJTYPE :5307 ;
  99. VMTLINK :OFS (TYPEOF (TBXDOUBLEEDIT )^);LOAD :@ TBXDOUBLEEDIT . LOAD ;STORE :@ TBXDOUBLEEDIT . STORE );{$ENDIF}
  100. CONST RBXREALEDIT :TSTREAMREC =(OBJTYPE :5308 ;VMTLINK :OFS (TYPEOF (TBXREALEDIT )^);LOAD :@ TBXREALEDIT . LOAD ;
  101. STORE :@ TBXREALEDIT . STORE );CONST RBXENTRYDIALOG :TSTREAMREC =(OBJTYPE :5309 ;
  102. VMTLINK :OFS (TYPEOF (TBXENTRYDIALOG )^);LOAD :@ TBXENTRYDIALOG . LOAD ;STORE :@ TBXENTRYDIALOG . STORE );
  103. CONST RBXCHECKBOXES :TSTREAMREC =(OBJTYPE :5310 ;VMTLINK :OFS (TYPEOF (TBXCHECKBOXES )^);LOAD :@ TBXCHECKBOXES . LOAD ;
  104. STORE :@ TBXCHECKBOXES . STORE );CONST RBXRADIOBUTTONS :TSTREAMREC =(OBJTYPE :5311 ;
  105. VMTLINK :OFS (TYPEOF (TBXRADIOBUTTONS )^);LOAD :@ TBXRADIOBUTTONS . LOAD ;STORE :@ TBXRADIOBUTTONS . STORE );
  106. CONST RBXSLIDER :TSTREAMREC =(OBJTYPE :5312 ;VMTLINK :OFS (TYPEOF (TBXSLIDER )^);LOAD :@ TBXSLIDER . LOAD ;STORE :@
  107. TBXSLIDER . STORE );CONST RBXSPINBAR :TSTREAMREC =(OBJTYPE :5313 ;VMTLINK :OFS (TYPEOF (TBXSPINBAR )^);LOAD :@
  108. TBXSPINBAR . LOAD ;STORE :@ TBXSPINBAR . STORE );CONST RBXSPINEDIT :TSTREAMREC =(OBJTYPE :5314 ;
  109. VMTLINK :OFS (TYPEOF (TBXSPINEDIT )^);LOAD :@ TBXSPINEDIT . LOAD ;STORE :@ TBXSPINEDIT . STORE );
  110. IMPLEMENTATION PROCEDURE SETDATEDEFAULTS ;VAR O1OlOIlOI10I:WORD;BEGIN GETDATE (DEFAULTYEAR , DEFAULTMONTH , DEFAULTDAY ,
  111. O1OlOIlOI10I );END ;FUNCTION OI1I1I10lIOI (OIOI:CHAR):CHAR ;BEGIN ASM {} MOV AL , OIOI{} CMP AL , 'A' {} JB @1 {}
  112. CMP AL , 'Z' {} JA @1 {} ADD AL , 'a' - 'A' {} @1 : MOV @RESULT , AL {} {} END;END ;CONSTRUCTOR TBXEDITLINE.INIT
  113. (VAR BOUNDS:TRECT;AMASK:STRING );VAR OIlO:BYTE;OOIO:BYTE;BEGIN OOIO := 0 ;IF (AMASK ='')THEN AMASK := 'X';FOR OIlO := 1
  114. TO BYTE (AMASK [ 0 ] ) DO IF (AMASK [ OIlO ] IN EDITMASKCHARS )THEN INC (OOIO );INHERITED INIT(BOUNDS , OOIO );MASK :=
  115. NEWSTR (AMASK );FIRST := 1 ;PADCHAR := ' ';WHILE (FIRST <= BYTE (MASK ^[ 0 ] ))AND NOT (AMASK [ FIRST ] IN EDITMASKCHARS
  116. ) DO INC (FIRST );LLABEL := NIL ;ID := 0 ;EDITFLAGS := 0 ;EVENTMASK := EVENTMASK OR EVBROADCAST ;END ;
  117. DESTRUCTOR TBXEDITLINE.DONE ;BEGIN INHERITED DONE;DISPOSESTR (MASK );END ;CONSTRUCTOR TBXEDITLINE.LOAD (VAR S:TSTREAM);
  118. BEGIN INHERITED LOAD(S );S.READ (PADCHAR , SIZEOF (CHAR ));S.READ (XPOS , SIZEOF (BYTE ));S.READ (FIRST , SIZEOF (FIRST
  119. ));MASK := S.READSTR ;S.READ (ID , SIZEOF (BYTE ));GETPEERVIEWPTR (S , LLABEL );S.READ (EDITFLAGS , SIZEOF (WORD ));
  120. END ;PROCEDURE TBXEDITLINE.ADDLABEL (ALABEL:PLABEL);BEGIN LLABEL := ALABEL ;END ;FUNCTION TBXEDITLINE.CANSCROLL
  121. (SCROLLLEFT:BOOLEAN):BOOLEAN ;BEGIN IF ((EDITFLAGS AND DFRJUSTIFY )<> 0 )THEN CANSCROLL := FALSE ELSE IF SCROLLLEFT THEN
  122. CANSCROLL := (FIRSTPOS > 1 )ELSE CANSCROLL := ((LENGTH (MASK ^)- FIRSTPOS + 1 )> (SIZE.X - 2 ));END ;
  123. FUNCTION TBXEDITLINE.DATASIZE :WORD ;BEGIN DATASIZE := LENGTH (MASK ^)+ 1 ;END ;PROCEDURE TBXEDITLINE.DELETEMARKED ;
  124. BEGIN IF (SELSTART <> SELEND )THEN BEGIN DELETE (DATA ^, SELSTART , SELEND - SELSTART + 1 );XPOS := SELSTART ;CURPOS :=
  125. EDITTOMASKPOS (XPOS );END ;END ;PROCEDURE TBXEDITLINE.DRAW ;VAR O11lIOII:STRING ;OOllOI000O1l:BYTE;OIO1:TDRAWBUFFER;
  126. OO01,OO1I:INTEGER;BEGIN MERGE (O11lIOII , (STATE AND SFSELECTED =0 ));IF (STATE AND SFFOCUSED =0 )THEN OOllOI000O1l :=
  127. GETCOLOR (1 )ELSE OOllOI000O1l := GETCOLOR (2 );MOVECHAR (OIO1 , ' ', OOllOI000O1l , SIZE.X );MOVESTR (OIO1 [ 1 ] , COPY
  128. (O11lIOII , FIRSTPOS , SIZE.X - 2 ), OOllOI000O1l );IF CANSCROLL (RIGHT )THEN MOVECHAR (OIO1 [ SIZE.X - 1 ] , #16,
  129. GETCOLOR (4 ), 1 );IF (STATE AND SFSELECTED <> 0 )THEN BEGIN IF CANSCROLL (LEFT )THEN MOVECHAR (OIO1 [ 0 ] , #17,
  130. GETCOLOR (4 ), 1 );OO01 := SELSTART - FIRSTPOS + 1 ;IF (OO01 < 1 )THEN OO01 := 1 ;OO1I := SELEND - FIRSTPOS + 1 ;IF (OO1I
  131. > SIZE.X - 1 )THEN OO1I := SIZE.X - 1 ;IF (OO01 < OO1I )THEN MOVECHAR (OIO1 [ OO01 ] , #0, GETCOLOR (3 ), OO1I - OO01 + 1
  132. );END ;WRITELINE (0 , 0 , SIZE.X , SIZE.Y , OIO1 );SETCURSOR (CURPOS - FIRSTPOS + 1 , 0 );END ;
  133. FUNCTION TBXEDITLINE.EDITTOMASKPOS (POS:INTEGER):INTEGER ;VAR OOIO:INTEGER;OIOO101OlII:INTEGER;BEGIN OIOO101OlII := 0 ;
  134. FOR OOIO := 1 TO POS  DO REPEAT INC (OIOO101OlII );UNTIL (MASK ^[ OIOO101OlII ] IN EDITMASKCHARS );EDITTOMASKPOS :=
  135. OIOO101OlII ;END ;FUNCTION TBXEDITLINE.EMPTY :BOOLEAN ;BEGIN EMPTY := ALLBLANKS (DATA ^);END ;
  136. PROCEDURE TBXEDITLINE.GETDATA (VAR REC);VAR OIOI100IlI0:STRING ;OOIlOl0l0l1l:WORD;BEGIN OOIlOl0l0l1l := EDITFLAGS ;
  137. EDITFLAGS := EDITFLAGS AND NOT DFHIDE ;MERGE (OIOI100IlI0 , TRUE );EDITFLAGS := OOIlOl0l0l1l ;MOVE (OIOI100IlI0 , REC ,
  138. DATASIZE );END ;FUNCTION TBXEDITLINE.GETFIELDNAME :STRING ;VAR OI111IlIOOl0:STRING ;BEGIN IF (LLABEL <> NIL )THEN
  139. BEGIN OI111IlIOOl0 := PLABEL (LLABEL )^. TEXT ^;STRIP (OI111IlIOOl0 , [ '~'] );END ELSE OI111IlIOOl0 := '';GETFIELDNAME
  140. := OI111IlIOOl0 ;END ;FUNCTION TBXEDITLINE.GETID :WORD ;BEGIN GETID := ID ;END ;PROCEDURE TBXEDITLINE.HANDLEEVENT
  141. (VAR EVENT:TEVENT);FUNCTION O10O11lIO100O (VAR OIOl00O1O1O:BOOLEAN):BOOLEAN ;VAR OI1I1O1lll10:TPOINT;BEGIN MAKELOCAL
  142. (EVENT.WHERE , OI1I1O1lll10 );IF (OI1I1O1lll10.X <= 0 )THEN BEGIN O10O11lIO100O := TRUE ;OIOl00O1O1O := LEFT ;END ELSE IF
  143. (OI1I1O1lll10.X >= SIZE.X - 1 )THEN BEGIN O10O11lIO100O := TRUE ;OIOl00O1O1O := RIGHT ;END ELSE BEGIN O10O11lIO100O :=
  144. FALSE ;END ;END ;FUNCTION Ol1lIl0010 :INTEGER ;VAR OIOllI0O1OI:INTEGER;OI1I1O1lll10:TPOINT;BEGIN MAKELOCAL (EVENT.WHERE ,
  145. OI1I1O1lll10 );IF (OI1I1O1lll10.X < 1 )THEN OI1I1O1lll10.X := 1 ;OIOllI0O1OI := OI1I1O1lll10.X + FIRSTPOS - 1 ;IF
  146. (OIOllI0O1OI < 1 )THEN OIOllI0O1OI := 1 ELSE IF (OIOllI0O1OI > EDITTOMASKPOS (LENGTH (DATA ^)))THEN OIOllI0O1OI :=
  147. EDITTOMASKPOS (LENGTH (DATA ^));IF NOT (MASK ^[ OIOllI0O1OI ] IN EDITMASKCHARS )THEN OIOllI0O1OI := NEXTPOS (OIOllI0O1OI
  148. );IF NOT (MASK ^[ OIOllI0O1OI ] IN EDITMASKCHARS )THEN OIOllI0O1OI := PREVPOS (OIOllI0O1OI );Ol1lIl0010 := OIOllI0O1OI ;
  149. END ;PROCEDURE OIO101I1O1I (OIOl00O1O1O:BOOLEAN);BEGIN IF CANSCROLL (OIOl00O1O1O )THEN BEGIN IF (OIOl00O1O1O =LEFT )THEN
  150. BEGIN DEC (XPOS );DEC (FIRSTPOS );CURPOS := PREVPOS (CURPOS );END ELSE BEGIN INC (XPOS );INC (FIRSTPOS );CURPOS :=
  151. NEXTPOS (CURPOS );END ;END ;END ;VAR OOllO0l1I10l:INTEGER;OOIO:INTEGER;OIlOOO1I1I:BOOLEAN;OOII0I0lOOO1:BOOLEAN;
  152. OIOI100IlI0:STRING ;BEGIN TVIEW.HANDLEEVENT (EVENT );CASE EVENT.WHAT  OF EVMOUSEDOWN :BEGIN IF (STATE AND SFSELECTED <> 0
  153. )THEN BEGIN IF O10O11lIO100O (OOII0I0lOOO1 )THEN BEGIN REPEAT OIO101I1O1I (OOII0I0lOOO1 );DRAWVIEW ;UNTIL NOT MOUSEEVENT
  154. (EVENT , EVMOUSEAUTO );END ELSE IF EVENT.DOUBLE THEN BEGIN SELECTALL (TRUE );END ELSE BEGIN OOllO0l1I10l := Ol1lIl0010 ;
  155. REPEAT IF (EVENT.WHAT =EVMOUSEAUTO )THEN BEGIN IF O10O11lIO100O (OOII0I0lOOO1 )THEN OIO101I1O1I (OOII0I0lOOO1 );END ELSE
  156. BEGIN CURPOS := Ol1lIl0010 ;XPOS := MASKTOEDITPOS (CURPOS );END ;IF (CURPOS < OOllO0l1I10l )THEN BEGIN SELSTART := CURPOS
  157. ;SELEND := OOllO0l1I10l ;END ELSE BEGIN SELSTART := OOllO0l1I10l ;SELEND := CURPOS ;END ;DRAWVIEW ;UNTIL NOT MOUSEEVENT
  158. (EVENT , EVMOUSEMOVE + EVMOUSEAUTO );END ;END ;CLEAREVENT (EVENT );END ;EVKEYDOWN :BEGIN CASE CTRLTOARROW (EVENT.KEYCODE
  159. ) OF KBLEFT :BEGIN IF (XPOS > 1 )THEN BEGIN DEC (XPOS );CURPOS := PREVPOS (CURPOS );END ;END ;KBRIGHT :BEGIN IF (XPOS <=
  160. LENGTH (DATA ^))THEN IF (XPOS <= MAXLEN )THEN BEGIN INC (XPOS );CURPOS := NEXTPOS (CURPOS );END ;END ;KBHOME :BEGIN XPOS
  161. := 1 ;CURPOS := HOMEPOS ;END ;KBEND :BEGIN XPOS := LENGTH (DATA ^);CURPOS := NEXTPOS (EDITTOMASKPOS (XPOS ));INC (XPOS );
  162. END ;KBBACK :BEGIN IF (XPOS > 1 )THEN BEGIN DEC (XPOS );CURPOS := PREVPOS (CURPOS );DELETE (DATA ^, XPOS , 1 );IF
  163. (FIRSTPOS > 1 )THEN DEC (FIRSTPOS );END ;END ;KBDEL :BEGIN IF (SELSTART =SELEND )THEN DELETE (DATA ^, XPOS , 1 )ELSE
  164. DELETEMARKED ;END ;KBINS :BEGIN SETSTATE (SFCURSORINS , STATE AND SFCURSORINS =0 );END ;ELSE CASE EVENT.CHARCODE
  165.  OF ' '.. #255:BEGIN CASE (MASK ^[ CURPOS ] ) OF DATEONLY :BEGIN OIlOOO1I1I := EVENT.CHARCODE IN DATEONLYSET ;END ;
  166. HEXONLY :BEGIN OIlOOO1I1I := EVENT.CHARCODE IN HEXONLYSET ;END ;DIGITONLY :BEGIN OIlOOO1I1I := EVENT.CHARCODE IN
  167. DIGITONLYSET ;END ;ANYCHAR :BEGIN OIlOOO1I1I := TRUE ;END ;FORCEUP :BEGIN EVENT.CHARCODE := UPCASE (EVENT.CHARCODE );
  168. OIlOOO1I1I := TRUE ;END ;FORCELO :BEGIN EVENT.CHARCODE := OI1I1I10lIOI (EVENT.CHARCODE );OIlOOO1I1I := TRUE ;END ;
  169. ALPHAONLY :BEGIN OIlOOO1I1I := EVENT.CHARCODE IN ALPHAONLYSET ;END ;UPPERALPHA :BEGIN EVENT.CHARCODE := UPCASE
  170. (EVENT.CHARCODE );OIlOOO1I1I := EVENT.CHARCODE IN ALPHAONLYSET ;END ;LOWERALPHA :BEGIN EVENT.CHARCODE := OI1I1I10lIOI
  171. (EVENT.CHARCODE );OIlOOO1I1I := EVENT.CHARCODE IN ALPHAONLYSET ;END ;NUMBERONLY :BEGIN OIlOOO1I1I := EVENT.CHARCODE IN
  172. NUMBERONLYSET ;END ;ELSE OIlOOO1I1I := FALSE ;END ;IF OIlOOO1I1I THEN BEGIN INSERTCHAR (EVENT.CHARCODE );END ;END ;^Y
  173. :BEGIN DATA ^:= '';XPOS := 1 ;CURPOS := HOMEPOS ;END ;ELSE EXIT ;END ;END ;SELSTART := 1 ;SELEND := 1 ;IF (FIRSTPOS >
  174. CURPOS )THEN BEGIN IF (CURPOS =HOMEPOS )THEN FIRSTPOS := 1 ELSE FIRSTPOS := CURPOS ;END ;OOIO := CURPOS - SIZE.X + 2 ;IF
  175. (FIRSTPOS < OOIO )THEN FIRSTPOS := OOIO ;DRAWVIEW ;CLEAREVENT (EVENT );END ;EVBROADCAST :BEGIN CASE EVENT.COMMAND
  176.  OF CMSETID :BEGIN SETID (EVENT.INFOWORD );CLEAREVENT (EVENT );EVENT.INFOPTR := @ SELF ;END ;CMIDENTIFY :IF
  177. (EVENT.INFOWORD =ID )THEN BEGIN CLEAREVENT (EVENT );EVENT.INFOPTR := @ SELF ;END ;END ;END ;END ;END ;
  178. FUNCTION TBXEDITLINE.HOMEPOS :INTEGER ;BEGIN HOMEPOS := FIRST ;END ;PROCEDURE TBXEDITLINE.INSERTCHAR (CH:CHAR);BEGIN IF
  179. (STATE AND SFCURSORINS <> 0 )THEN DELETE (DATA ^, XPOS , 1 )ELSE DELETEMARKED ;IF (LENGTH (DATA ^)< MAXLEN )THEN BEGIN IF
  180. (FIRSTPOS > CURPOS )THEN FIRSTPOS := CURPOS ;INSERT (CH , DATA ^, XPOS );IF (XPOS <= MAXLEN )THEN BEGIN INC (XPOS );
  181. CURPOS := NEXTPOS (CURPOS );END ;END ;END ;PROCEDURE TBXEDITLINE.LOCK ;BEGIN SETSTATE (SFDISABLED , TRUE );END ;
  182. FUNCTION TBXEDITLINE.MASKTOEDITPOS (POS:INTEGER):INTEGER ;VAR OOIO:INTEGER;OIOO101OlII:INTEGER;BEGIN OIOO101OlII := 0 ;
  183. FOR OOIO := 1 TO POS  DO IF (MASK ^[ OOIO ] IN EDITMASKCHARS )THEN INC (OIOO101OlII );MASKTOEDITPOS := OIOO101OlII ;
  184. END ;PROCEDURE TBXEDITLINE.MERGE (VAR ST:STRING ;JUSTIFY:BOOLEAN);VAR OIlO,OIll:BYTE;OIOI100IlI0:STRING ;BEGIN OIll := 0
  185. ;FOR OIlO := 1 TO BYTE (MASK ^[ 0 ] ) DO BEGIN IF (MASK ^[ OIlO ] IN EDITMASKCHARS )THEN BEGIN IF (OIll < BYTE (DATA ^[ 0
  186. ] ))THEN BEGIN INC (OIll );IF ((EDITFLAGS AND DFHIDE )<> 0 )THEN ST [ OIlO ] := HIDECHAR ELSE ST [ OIlO ] := DATA ^[ OIll
  187. ] ;END ELSE BEGIN ST [ OIlO ] := PADCHAR ;END ;END ELSE BEGIN ST [ OIlO ] := MASK ^[ OIlO ] ;END ;END ;BYTE (ST [ 0 ] ):=
  188. OIlO ;IF JUSTIFY THEN BEGIN IF ((EDITFLAGS AND DFRJUSTIFY )<> 0 )THEN BEGIN TRIMCH (ST , PADCHAR );LEFTPADCH (ST , MAXLEN
  189. , PADCHAR );END ELSE IF ((EDITFLAGS AND DFLJUSTIFY )<> 0 )THEN BEGIN TRIMCH (ST , PADCHAR );PADCH (ST , MAXLEN , PADCHAR
  190. );END ELSE IF ((EDITFLAGS AND DFTRIM )<> 0 )THEN TRIMCH (ST , PADCHAR )ELSE PADCH (ST , MAXLEN , PADCHAR );END ;END ;
  191. FUNCTION TBXEDITLINE.NEXTPOS (POS:INTEGER):INTEGER ;VAR OOIO:INTEGER;BEGIN OOIO := POS + 1 ;WHILE (OOIO <= BYTE (MASK ^[
  192. 0 ] ))AND NOT (MASK ^[ OOIO ] IN EDITMASKCHARS ) DO INC (OOIO );IF (OOIO <= BYTE (MASK ^[ 0 ] )+ 1 )THEN NEXTPOS := OOIO
  193. ELSE NEXTPOS := POS ;END ;FUNCTION TBXEDITLINE.PREVPOS (POS:INTEGER):INTEGER ;VAR OOIO:INTEGER;BEGIN OOIO := POS - 1 ;
  194. WHILE (OOIO > 0 )AND NOT (MASK ^[ OOIO ] IN EDITMASKCHARS ) DO DEC (OOIO );IF (OOIO > 0 )THEN PREVPOS := OOIO ELSE
  195. PREVPOS := POS ;END ;FUNCTION TBXEDITLINE.REMOVE (CONST ST:STRING ):STRING ;VAR OIlO,OIll:BYTE;OIOI100IlI0:STRING ;
  196. BEGIN OIll := 0 ;FILLCHAR (OIOI100IlI0 , SIZEOF (OIOI100IlI0 ), 0 );FOR OIlO := 1 TO BYTE (ST [ 0 ] ) DO BEGIN IF (MASK
  197. ^[ OIlO ] IN EDITMASKCHARS )THEN BEGIN INC (OIll );OIOI100IlI0 [ OIll ] := ST [ OIlO ] ;END END ;BYTE (OIOI100IlI0 [ 0 ]
  198. ):= OIll ;REMOVE := OIOI100IlI0 ;END ;PROCEDURE TBXEDITLINE.SELECTALL (ENABLE:BOOLEAN);BEGIN CURPOS := HOMEPOS ;XPOS :=
  199. MASKTOEDITPOS (CURPOS );FIRSTPOS := 1 ;SELSTART := 1 ;IF (ENABLE AND (BYTE (DATA ^[ 0 ] )> 0 ))THEN SELEND := BYTE (MASK
  200. ^[ 0 ] )ELSE SELEND := 1 ;DRAWVIEW ;END ;PROCEDURE TBXEDITLINE.SETDATA (VAR REC);BEGIN DATA ^:= FTRIMCH (REMOVE (STRING
  201. (REC )), PADCHAR );SELECTALL (TRUE );END ;PROCEDURE TBXEDITLINE.SETEDITFLAG (AFLAG:WORD;ENABLE:BOOLEAN);BEGIN IF ENABLE
  202. THEN EDITFLAGS := EDITFLAGS OR AFLAG ELSE EDITFLAGS := EDITFLAGS AND NOT AFLAG ;IF ENABLE AND (AFLAG AND (DFREQUIRED OR
  203. DFDEFAULTS )<> 0 )THEN OPTIONS := OPTIONS OR OFVALIDATE ;END ;PROCEDURE TBXEDITLINE.SETID (AFIELDID:WORD);BEGIN ID :=
  204. AFIELDID ;END ;PROCEDURE TBXEDITLINE.SETSTATE (ASTATE:WORD;ENABLE:BOOLEAN);BEGIN TVIEW.SETSTATE (ASTATE , ENABLE );IF
  205. (ASTATE =SFSELECTED )OR ((ASTATE =SFACTIVE )AND (STATE AND SFSELECTED <> 0 ))THEN SELECTALL (ENABLE )ELSE IF (ASTATE AND
  206. SFDISABLED <> 0 )THEN IF (LLABEL <> NIL )THEN LLABEL ^. SETSTATE (SFDISABLED , ENABLE );END ;PROCEDURE TBXEDITLINE.STORE
  207. (VAR S:TSTREAM);BEGIN INHERITED STORE(S );S.WRITE (PADCHAR , SIZEOF (CHAR ));S.WRITE (XPOS , SIZEOF (BYTE ));S.WRITE
  208. (FIRST , SIZEOF (BYTE ));S.WRITESTR (MASK );S.WRITE (ID , SIZEOF (BYTE ));PUTPEERVIEWPTR (S , LLABEL );S.WRITE (EDITFLAGS
  209. , SIZEOF (WORD ));END ;PROCEDURE TBXEDITLINE.UNLOCK ;BEGIN SETSTATE (SFDISABLED , FALSE );END ;
  210. FUNCTION TBXEDITLINE.VALID (COMMAND:WORD):BOOLEAN ;VAR O10lII00l:STRING ;BEGIN IF (COMMAND <> CMCANCEL )AND (COMMAND <>
  211. CMVALID )AND ((EDITFLAGS AND DFREQUIRED )<> 0 )AND EMPTY THEN BEGIN O10lII00l := GETFIELDNAME + ^M +
  212. 'Field is required.';MESSAGE (OWNER , EVBROADCAST , CMFIELDERROR , @ O10lII00l );VALID := FALSE ;SELECT ;END ELSE VALID
  213. := INHERITED VALID(COMMAND );END ;CONSTRUCTOR TBXDATEEDIT.INIT (VAR BOUNDS:TRECT;ADATEPIC:TBXDATEST);VAR OO1O:TBXDATEST;
  214. OIlO:BYTE;BEGIN OO1O := ADATEPIC ;FOR OIlO := 1 TO LENGTH (OO1O ) DO CASE OO1O [ OIlO ]  OF 'm', 'M', 'd', 'D', 'y',
  215. 'Y':OO1O [ OIlO ] := '@';END ;INHERITED INIT(BOUNDS , OO1O );DATEPIC := ADATEPIC ;DATE := NEW (PBXDATE , INIT (0 , 0 , 0
  216. ));END ;CONSTRUCTOR TBXDATEEDIT.LOAD (VAR S:TSTREAM);BEGIN INHERITED LOAD(S );S.READ (DATEPIC , SIZEOF (TBXDATEST ));
  217. DATE := NEW (PBXDATE , LOAD (S ));END ;FUNCTION TBXDATEEDIT.DATASIZE :WORD ;BEGIN DATASIZE := SIZEOF (TBXDATEREC );END ;
  218. PROCEDURE TBXDATEEDIT.GETDATA (VAR REC);BEGIN DATE ^. GETDATA (REC );END ;PROCEDURE TBXDATEEDIT.SETDATA (VAR REC);
  219. BEGIN DATE ^. SETDATA (REC );DATA ^:= REMOVE (DATE ^. DATESTRING (DATEPIC ));SELECTALL (TRUE );END ;
  220. PROCEDURE TBXDATEEDIT.STORE (VAR S:TSTREAM);BEGIN INHERITED STORE(S );S.WRITE (DATEPIC , SIZEOF (TBXDATEST ));DATE ^.
  221. STORE (S );END ;FUNCTION TBXDATEEDIT.VALID (COMMAND:WORD):BOOLEAN ;VAR OI0l1lIl1OII:BOOLEAN;O1Ol0OlOO01I:BOOLEAN;
  222. O110l10l:BOOLEAN;OO1O:TBXDATEST;O10lII00l:STRING ;BEGIN IF (COMMAND <> CMCANCEL )AND (COMMAND <> CMVALID )AND NOT EMPTY
  223. THEN BEGIN VALID := TRUE ;MERGE (OO1O , FALSE );DATE ^. EXTRACTDATE (DATEPIC , OO1O );OI0l1lIl1OII := (POS ('d', DATEPIC
  224. )<> 0 )OR (POS ('D', DATEPIC )<> 0 );O1Ol0OlOO01I := (POS ('m', DATEPIC )<> 0 )OR (POS ('M', DATEPIC )<> 0 );IF
  225. (EDITFLAGS AND DFDEFAULTS <> 0 )THEN BEGIN O1Ol0OlOO01I := TRUE ;OI0l1lIl1OII := TRUE ;IF (DATE ^. YEAR =0 )OR (DATE ^.
  226. DAY =0 )OR (DATE ^. MONTH =0 )THEN BEGIN IF (DATE ^. YEAR =0 )THEN DATE ^. YEAR := DEFAULTYEAR ;IF (DATE ^. DAY =0 )THEN
  227. DATE ^. DAY := DEFAULTDAY ;IF (DATE ^. MONTH =0 )THEN DATE ^. MONTH := DEFAULTMONTH ;DATA ^:= REMOVE (DATE ^. DATESTRING
  228. (DATEPIC ));DRAWVIEW ;END ;END ;IF (O1Ol0OlOO01I AND OI0l1lIl1OII )THEN O110l10l := DATE ^. VALID ELSE IF O1Ol0OlOO01I
  229. THEN O110l10l := (DATE ^. MONTH > 0 )AND (DATE ^. MONTH < 13 )ELSE O110l10l := TRUE ;IF NOT O110l10l THEN BEGIN VALID :=
  230. FALSE ;SELECT ;O10lII00l := GETFIELDNAME + ^M + 'Date is not valid.'+ ^M + 'Enter a date in '+ DATEPIC + ' format.';
  231. MESSAGE (OWNER , EVBROADCAST , CMFIELDERROR , @ O10lII00l );END ;END ELSE VALID := INHERITED VALID(COMMAND );END ;
  232. DESTRUCTOR TBXDATEEDIT.DONE ;BEGIN DISPOSE (DATE , DONE );INHERITED DONE;END ;PROCEDURE TBXNUMERICEDIT.HANDLEEVENT
  233. (VAR EVENT:TEVENT);VAR OIlOOO1I1I:BOOLEAN;BEGIN IF (EVENT.WHAT =EVKEYDOWN )THEN BEGIN CASE EVENT.CHARCODE  OF ' '..
  234. #255:BEGIN CASE (MASK ^[ CURPOS ] ) OF DIGITONLY :OIlOOO1I1I := (EVENT.CHARCODE IN DIGITONLYSET );NUMBERONLY :OIlOOO1I1I
  235. := (EVENT.CHARCODE IN NUMBERONLYSET );HEXONLY :OIlOOO1I1I := (EVENT.CHARCODE IN HEXONLYSET );ELSE OIlOOO1I1I := FALSE ;
  236. END ;IF NOT OIlOOO1I1I THEN CLEAREVENT (EVENT )ELSE CASE EVENT.CHARCODE  OF '-', '$':BEGIN IF (BYTE (DATA ^[ 0 ] )> 0
  237. )THEN BEGIN IF (DATA ^[ 1 ] <> EVENT.CHARCODE )AND (BYTE (DATA ^[ 0 ] )< MAXLEN )THEN BEGIN INSERT (EVENT.CHARCODE , DATA
  238. ^, 1 );CURPOS := NEXTPOS (CURPOS );END ELSE IF (DATA ^[ 1 ] =EVENT.CHARCODE )THEN BEGIN DELETE (DATA ^, 1 , 1 );CURPOS :=
  239. PREVPOS (CURPOS );END ;XPOS := MASKTOEDITPOS (CURPOS );DRAWVIEW ;CLEAREVENT (EVENT );END ;END ;END ;END ;END ;END ;
  240. INHERITED HANDLEEVENT(EVENT );END ;FUNCTION TBXNUMERICEDIT.OUTOFRANGEMSG :STRING ;BEGIN OUTOFRANGEMSG :=
  241. 'Entry is not in valid range';END ;FUNCTION TBXNUMERICEDIT.OUTOFRANGE :BOOLEAN ;BEGIN OUTOFRANGE := FALSE ;END ;
  242. FUNCTION TBXNUMERICEDIT.VALID (COMMAND:WORD):BOOLEAN ;VAR O10lII00l:STRING ;BEGIN VALID := TRUE ;IF (COMMAND <> CMCANCEL
  243. )AND (COMMAND <> CMVALID )AND OUTOFRANGE THEN BEGIN VALID := FALSE ;SELECT ;O10lII00l := GETFIELDNAME + ^M +
  244. OUTOFRANGEMSG ;MESSAGE (OWNER , EVBROADCAST , CMFIELDERROR , @ O10lII00l );END ELSE VALID := INHERITED VALID(COMMAND );
  245. END ;CONSTRUCTOR TBXLONGEDIT.INIT (VAR BOUNDS:TRECT;CONST AMASK:STRING ;AMIN:LONGINT;AMAX:LONGINT);
  246. BEGIN INHERITED INIT(BOUNDS , AMASK );IF (AMIN <= AMAX )THEN BEGIN MIN := AMIN ;MAX := AMAX ;END ELSE BEGIN MIN := AMAX ;
  247. MAX := AMIN ;END ;END ;CONSTRUCTOR TBXLONGEDIT.LOAD (VAR S:TSTREAM);BEGIN INHERITED LOAD(S );S.READ (MIN , SIZEOF
  248. (LONGINT ));S.READ (MAX , SIZEOF (LONGINT ));END ;FUNCTION TBXLONGEDIT.DATASIZE :WORD ;BEGIN DATASIZE := SIZEOF (LONGINT
  249. );END ;PROCEDURE TBXLONGEDIT.GETDATA (VAR REC);BEGIN IF (DATA ^='')OR (DATA ^='$')OR (DATA ^='-')THEN DATA ^:= '0';VAL
  250. (DATA ^, LONGINT (REC ), ERRCODE );IF (ERRCODE <> 0 )THEN LONGINT (REC ):= 0 ;END ;FUNCTION TBXLONGEDIT.OUTOFRANGE
  251. :BOOLEAN ;VAR OI1IO1O100Ol:LONGINT;BEGIN OUTOFRANGE := FALSE ;IF (MIN <> 0 )OR (MAX <> 0 )THEN BEGIN TBXLONGEDIT.GETDATA
  252. (OI1IO1O100Ol );IF (ERRCODE =0 )THEN OUTOFRANGE := ((OI1IO1O100Ol < MIN )OR (OI1IO1O100Ol > MAX ));END ;END ;
  253. FUNCTION TBXLONGEDIT.OUTOFRANGEMSG :STRING ;VAR Ol00II0OlO10,Ol00II00OI00:STRING [ 11 ] ;BEGIN STR (MIN , Ol00II0OlO10 );
  254. STR (MAX , Ol00II00OI00 );TRIM (Ol00II0OlO10 );TRIM (Ol00II00OI00 );OUTOFRANGEMSG := 'Valid Range is '+ Ol00II0OlO10 +
  255. ' to '+ Ol00II00OI00 ;END ;PROCEDURE TBXLONGEDIT.SETDATA (VAR REC);BEGIN IF (MIN <> 0 )OR (MAX <> 0 )THEN IF (LONGINT
  256. (REC )< MIN )THEN LONGINT (REC ):= MIN ELSE IF (LONGINT (REC )> MAX )THEN LONGINT (REC ):= MAX ;STR (LONGINT (REC ), DATA
  257. ^);TRIM (DATA ^);SELECTALL (TRUE );END ;PROCEDURE TBXLONGEDIT.STORE (VAR S:TSTREAM);BEGIN INHERITED STORE(S );S.WRITE
  258. (MIN , SIZEOF (LONGINT ));S.WRITE (MAX , SIZEOF (LONGINT ));END ;FUNCTION TBXHEXEDIT.OUTOFRANGEMSG :STRING ;
  259. VAR Ol00II0OlO10,Ol00II00OI00:STRING [ 16 ] ;BEGIN OUTOFRANGEMSG := 'Range is '+ HEXSTRING (MIN )+ ' to '+ HEXSTRING (MAX
  260. );END ;PROCEDURE TBXHEXEDIT.SETDATA (VAR REC);VAR OO1O:STRING [ 9 ] ;BEGIN OO1O := HEXSTRING (LONGINT (REC ));
  261. WHILE (BYTE (OO1O [ 0 ] )> MAXLEN )AND (OO1O [ 2 ] ='0') DO DELETE (OO1O , 2 , 1 );TRUNCATESTR (OO1O , MAXLEN );DATA ^:=
  262. OO1O ;SELECTALL (TRUE );END ;CONSTRUCTOR TBXINTEGEREDIT.INIT (VAR BOUNDS:TRECT;CONST AMASK:STRING ;AMIN:INTEGER;
  263. AMAX:INTEGER);BEGIN INHERITED INIT(BOUNDS , AMASK , AMIN , AMAX );END ;FUNCTION TBXINTEGEREDIT.DATASIZE :WORD ;
  264. BEGIN DATASIZE := SIZEOF (INTEGER );END ;PROCEDURE TBXINTEGEREDIT.GETDATA (VAR REC);VAR OO01:LONGINT;
  265. BEGIN TBXLONGEDIT.GETDATA (OO01 );INTEGER (REC ):= OO01 ;END ;PROCEDURE TBXINTEGEREDIT.SETDATA (VAR REC);
  266. VAR OO01:LONGINT;BEGIN OO01 := INTEGER (REC );TBXLONGEDIT.SETDATA (OO01 );END ;CONSTRUCTOR TBXWORDEDIT.INIT
  267. (VAR BOUNDS:TRECT;CONST AMASK:STRING ;AMIN:WORD;AMAX:WORD);BEGIN INHERITED INIT(BOUNDS , AMASK , AMIN , AMAX );END ;
  268. FUNCTION TBXWORDEDIT.DATASIZE :WORD ;BEGIN DATASIZE := SIZEOF (WORD );END ;PROCEDURE TBXWORDEDIT.GETDATA (VAR REC);
  269. VAR OO01:LONGINT;BEGIN TBXLONGEDIT.GETDATA (OO01 );WORD (REC ):= OO01 ;END ;PROCEDURE TBXWORDEDIT.SETDATA (VAR REC);
  270. VAR OO01:LONGINT;BEGIN OO01 := WORD (REC );TBXLONGEDIT.SETDATA (OO01 );END ;CONSTRUCTOR TBXBYTEEDIT.INIT
  271. (VAR BOUNDS:TRECT;CONST AMASK:STRING ;AMIN:BYTE;AMAX:BYTE);BEGIN TBXLONGEDIT.INIT (BOUNDS , AMASK , AMIN , AMAX );END ;
  272. FUNCTION TBXBYTEEDIT.DATASIZE :WORD ;BEGIN DATASIZE := SIZEOF (BYTE );END ;PROCEDURE TBXBYTEEDIT.GETDATA (VAR REC);
  273. VAR OO01:LONGINT;BEGIN TBXLONGEDIT.GETDATA (OO01 );BYTE (REC ):= OO01 ;END ;PROCEDURE TBXBYTEEDIT.SETDATA (VAR REC);
  274. VAR OO01:LONGINT;BEGIN OO01 := BYTE (REC );TBXLONGEDIT.SETDATA (OO01 );END ;CONSTRUCTOR TBXFLOATEDIT.INIT
  275. (VAR BOUNDS:TRECT;CONST AMASK:STRING );VAR OOIO:BYTE;OIlO:BYTE;OO1O:STRING ;BEGIN OO1O := AMASK ;OOIO := POS (DECIMALPT ,
  276. OO1O );IF (OOIO <> 0 )THEN BEGIN OIlO := 0 ;REPEAT INC (OIlO );UNTIL (OO1O [ OIlO ] IN EDITMASKCHARS );OO1O [ OOIO ] :=
  277. OO1O [ OIlO ] ;END ;INHERITED INIT(BOUNDS , OO1O );IF (OOIO <> 0 )THEN DP := LENGTH (OO1O )- OOIO ELSE DP := 0 ;END ;
  278. CONSTRUCTOR TBXFLOATEDIT.LOAD (VAR S:TSTREAM);BEGIN INHERITED LOAD(S );S.READ (DP , SIZEOF (BYTE ));END ;
  279. PROCEDURE TBXFLOATEDIT.HANDLEEVENT (VAR EVENT:TEVENT);VAR OOIO:BYTE;BEGIN CASE EVENT.WHAT  OF EVKEYDOWN
  280. :BEGIN CASE CTRLTOARROW (EVENT.KEYCODE ) OF KBBACK :BEGIN IF (XPOS > 1 )THEN IF (DATA ^[ XPOS - 1 ] =DECIMALPT )THEN
  281. CLEAREVENT (EVENT );END ;KBDEL :BEGIN IF (XPOS <= LENGTH (DATA ^))THEN IF (DATA ^[ XPOS ] =DECIMALPT )THEN CLEAREVENT
  282. (EVENT );END ;ELSE CASE EVENT.CHARCODE  OF DECIMALPT :BEGIN IF (DP =0 )THEN BEGIN CLEAREVENT (EVENT );END ELSE IF (POS
  283. (DECIMALPT , DATA ^)<> 0 )THEN BEGIN XPOS := POS (DECIMALPT , DATA ^);CURPOS := NEXTPOS (EDITTOMASKPOS (XPOS ));INC (XPOS
  284. );CLEAREVENT (EVENT );DRAWVIEW ;END ELSE BEGIN INSERTCHAR (DECIMALPT );CLEAREVENT (EVENT );DRAWVIEW ;END ;END ;'0'..
  285. '9':BEGIN IF (DP <> 0 )THEN BEGIN OOIO := POS (DECIMALPT , DATA ^);IF (OOIO <> 0 )THEN IF (XPOS > OOIO )THEN IF ((LENGTH
  286. (DATA ^)- OOIO )=DP )THEN CLEAREVENT (EVENT );END ;END ;END ;END ;END ;END ;INHERITED HANDLEEVENT(EVENT );END ;
  287. PROCEDURE TBXFLOATEDIT.STORE (VAR S:TSTREAM);BEGIN INHERITED STORE(S );S.WRITE (DP , SIZEOF (BYTE ));END ;{$IFOPT N+}
  288. CONSTRUCTOR TBXDOUBLEEDIT.INIT (VAR BOUNDS:TRECT;CONST AMASK:STRING ;AMIN:DOUBLE;AMAX:DOUBLE);
  289. BEGIN INHERITED INIT(BOUNDS , AMASK );IF (AMIN <= AMAX )THEN BEGIN MIN := AMIN ;MAX := AMAX ;END ELSE BEGIN MIN := AMAX ;
  290. MAX := AMIN ;END ;END ;CONSTRUCTOR TBXDOUBLEEDIT.LOAD (VAR S:TSTREAM);BEGIN INHERITED LOAD(S );S.READ (MIN , SIZEOF
  291. (DOUBLE ));S.READ (MAX , SIZEOF (DOUBLE ));END ;FUNCTION TBXDOUBLEEDIT.DATASIZE :WORD ;BEGIN DATASIZE := SIZEOF (DOUBLE
  292. );END ;PROCEDURE TBXDOUBLEEDIT.GETDATA (VAR REC);BEGIN STRIP (DATA ^, [ '$'] );IF (DATA ^='')OR (DATA ^='-')THEN DATA ^:=
  293. '0';VAL (DATA ^, DOUBLE (REC ), ERRCODE );IF (ERRCODE <> 0 )THEN DOUBLE (REC ):= 0.0 ;END ;
  294. FUNCTION TBXDOUBLEEDIT.OUTOFRANGE :BOOLEAN ;VAR OI1IO1O100Ol:DOUBLE;BEGIN OUTOFRANGE := FALSE ;IF (MIN <> 0.0 )OR (MAX <>
  295. 0.0 )THEN BEGIN GETDATA (OI1IO1O100Ol );IF (ERRCODE =0 )THEN OUTOFRANGE := (OI1IO1O100Ol < MIN )OR (OI1IO1O100Ol > MAX );
  296. END ;END ;FUNCTION TBXDOUBLEEDIT.OUTOFRANGEMSG :STRING ;VAR Ol00II0OlO10,Ol00II00OI00:STRING [ 20 ] ;OOII:BYTE;BEGIN IF
  297. (DP > 0 )THEN OOII := 20 - DP - 1 ELSE OOII := 20 ;STR (MIN :OOII :DP , Ol00II0OlO10 );STR (MAX :OOII :DP , Ol00II00OI00
  298. );TRIM (Ol00II0OlO10 );TRIM (Ol00II00OI00 );OUTOFRANGEMSG := 'Valid Range is '+ Ol00II0OlO10 + ' to '+ Ol00II00OI00 ;
  299. END ;PROCEDURE TBXDOUBLEEDIT.SETDATA (VAR REC);VAR OOII:BYTE;BEGIN STRIP (DATA ^, [ '$'] );IF (DP > 0 )THEN OOII :=
  300. MAXLEN - DP - 1 ELSE OOII := MAXLEN ;IF (MIN <> 0.0 )OR (MAX <> 0.0 )THEN IF (DOUBLE (REC )< MIN )THEN DOUBLE (REC ):=
  301. MIN ELSE IF (DOUBLE (REC )> MAX )THEN DOUBLE (REC ):= MAX ;STR (DOUBLE (REC ):OOII :DP , DATA ^);TRIM (DATA ^);SELECTALL
  302. (TRUE );END ;PROCEDURE TBXDOUBLEEDIT.STORE (VAR S:TSTREAM);BEGIN INHERITED STORE(S );S.WRITE (MIN , SIZEOF (DOUBLE ));
  303. S.WRITE (MAX , SIZEOF (DOUBLE ));END ;{$ENDIF} CONSTRUCTOR TBXREALEDIT.INIT (VAR BOUNDS:TRECT;CONST AMASK:STRING ;
  304. AMIN:REAL;AMAX:REAL);BEGIN INHERITED INIT(BOUNDS , AMASK );IF (AMIN <= AMAX )THEN BEGIN MIN := AMIN ;MAX := AMAX ;
  305. END ELSE BEGIN MIN := AMAX ;MAX := AMIN ;END ;END ;CONSTRUCTOR TBXREALEDIT.LOAD (VAR S:TSTREAM);BEGIN INHERITED LOAD(S );
  306. S.READ (MIN , SIZEOF (REAL ));S.READ (MAX , SIZEOF (REAL ));END ;FUNCTION TBXREALEDIT.DATASIZE :WORD ;BEGIN DATASIZE :=
  307. SIZEOF (REAL );END ;PROCEDURE TBXREALEDIT.GETDATA (VAR REC);BEGIN STRIP (DATA ^, [ '$'] );IF (DATA ^='')OR (DATA
  308. ^='-')THEN DATA ^:= '0';VAL (DATA ^, REAL (REC ), ERRCODE );IF (ERRCODE <> 0 )THEN REAL (REC ):= 0.0 ;END ;
  309. FUNCTION TBXREALEDIT.OUTOFRANGE :BOOLEAN ;VAR OI1IO1O100Ol:REAL;BEGIN OUTOFRANGE := FALSE ;IF (MIN <> 0.0 )OR (MAX <> 0.0
  310. )THEN BEGIN TBXREALEDIT.GETDATA (OI1IO1O100Ol );IF (ERRCODE =0 )THEN OUTOFRANGE := (OI1IO1O100Ol < MIN )OR (OI1IO1O100Ol
  311. > MAX );END ;END ;FUNCTION TBXREALEDIT.OUTOFRANGEMSG :STRING ;VAR Ol00II0OlO10,Ol00II00OI00:STRING [ 20 ] ;OOII:BYTE;
  312. BEGIN IF (DP > 0 )THEN OOII := 20 - DP - 1 ELSE OOII := 20 ;STR (MIN :OOII :DP , Ol00II0OlO10 );STR (MAX :OOII :DP ,
  313. Ol00II00OI00 );TRIM (Ol00II0OlO10 );TRIM (Ol00II00OI00 );OUTOFRANGEMSG := 'Valid Range is '+ Ol00II0OlO10 + ' to '+
  314. Ol00II00OI00 ;END ;PROCEDURE TBXREALEDIT.SETDATA (VAR REC);VAR OOII:BYTE;BEGIN STRIP (DATA ^, [ '$'] );IF (DP > 0 )THEN
  315. OOII := MAXLEN - DP - 1 ELSE OOII := MAXLEN ;IF (MIN <> 0.0 )OR (MAX <> 0.0 )THEN IF (REAL (REC )< MIN )THEN REAL (REC
  316. ):= MIN ELSE IF (REAL (REC )> MAX )THEN REAL (REC ):= MAX ;STR (REAL (REC ):OOII :DP , DATA ^);TRIM (DATA ^);SELECTALL
  317. (TRUE );END ;PROCEDURE TBXREALEDIT.STORE (VAR S:TSTREAM);BEGIN INHERITED STORE(S );S.WRITE (MIN , SIZEOF (REAL ));
  318. S.WRITE (MAX , SIZEOF (REAL ));END ;CONSTRUCTOR TBXCHECKBOXES.INIT (VAR BOUNDS:TRECT;ASTRINGS:PSITEM);
  319. BEGIN INHERITED INIT(BOUNDS , ASTRINGS );LLABEL := NIL ;ID := 0 ;EDITFLAGS := 0 ;EVENTMASK := EVENTMASK OR EVBROADCAST ;
  320. END ;CONSTRUCTOR TBXCHECKBOXES.LOAD (VAR S:TSTREAM);BEGIN INHERITED LOAD(S );S.READ (ID , SIZEOF (BYTE ));GETPEERVIEWPTR
  321. (S , LLABEL );S.READ (EDITFLAGS , SIZEOF (WORD ));END ;PROCEDURE TBXCHECKBOXES.ADDLABEL (ALABEL:PLABEL);BEGIN LLABEL :=
  322. ALABEL ;END ;FUNCTION TBXCHECKBOXES.EMPTY :BOOLEAN ;BEGIN EMPTY := (VALUE =0 );END ;FUNCTION TBXCHECKBOXES.GETFIELDNAME
  323. :STRING ;VAR OI111IlIOOl0:STRING ;BEGIN IF (LLABEL <> NIL )THEN BEGIN OI111IlIOOl0 := PLABEL (LLABEL )^. TEXT ^;STRIP
  324. (OI111IlIOOl0 , [ '~'] );END ELSE OI111IlIOOl0 := '';GETFIELDNAME := OI111IlIOOl0 ;END ;FUNCTION TBXCHECKBOXES.GETID
  325. :WORD ;BEGIN GETID := ID ;END ;PROCEDURE TBXCHECKBOXES.HANDLEEVENT (VAR EVENT:TEVENT);BEGIN INHERITED HANDLEEVENT(EVENT
  326. );CASE EVENT.WHAT  OF EVBROADCAST :BEGIN CASE EVENT.COMMAND  OF CMSETID :BEGIN SETID (EVENT.INFOWORD );CLEAREVENT (EVENT
  327. );EVENT.INFOPTR := @ SELF ;END ;CMIDENTIFY :IF (EVENT.INFOWORD =ID )THEN BEGIN CLEAREVENT (EVENT );EVENT.INFOPTR := @
  328. SELF ;END ;END ;END ;END ;END ;PROCEDURE TBXCHECKBOXES.LOCK ;BEGIN SETSTATE (SFDISABLED , TRUE );END ;
  329. PROCEDURE TBXCHECKBOXES.SETEDITFLAG (AFLAG:WORD;ENABLE:BOOLEAN);BEGIN IF ENABLE THEN EDITFLAGS := EDITFLAGS OR AFLAG ELSE
  330. EDITFLAGS := EDITFLAGS AND NOT AFLAG ;IF ENABLE AND (AFLAG AND DFREQUIRED <> 0 )THEN OPTIONS := OPTIONS OR OFVALIDATE ;
  331. END ;PROCEDURE TBXCHECKBOXES.SETID (AFIELDID:WORD);BEGIN ID := AFIELDID ;END ;PROCEDURE TBXCHECKBOXES.SETSTATE
  332. (ASTATE:WORD;ENABLE:BOOLEAN);BEGIN INHERITED SETSTATE(ASTATE , ENABLE );IF (ASTATE AND SFDISABLED <> 0 )THEN IF (LLABEL
  333. <> NIL )THEN LLABEL ^. SETSTATE (SFDISABLED , ENABLE );END ;PROCEDURE TBXCHECKBOXES.STORE (VAR S:TSTREAM);
  334. BEGIN INHERITED STORE(S );S.WRITE (ID , SIZEOF (BYTE ));PUTPEERVIEWPTR (S , LLABEL );S.WRITE (EDITFLAGS , SIZEOF (WORD
  335. ));END ;PROCEDURE TBXCHECKBOXES.UNLOCK ;BEGIN SETSTATE (SFDISABLED , FALSE );END ;FUNCTION TBXCHECKBOXES.VALID
  336. (COMMAND:WORD):BOOLEAN ;VAR O10lII00l:STRING ;BEGIN IF (COMMAND <> CMCANCEL )AND (COMMAND <> CMVALID )AND ((EDITFLAGS AND
  337. DFREQUIRED )<> 0 )AND EMPTY THEN BEGIN O10lII00l := GETFIELDNAME + ^M + 'Field is required.';MESSAGE (OWNER , EVBROADCAST
  338. , CMFIELDERROR , @ O10lII00l );VALID := FALSE ;SELECT ;END ELSE VALID := INHERITED VALID(COMMAND );END ;
  339. CONSTRUCTOR TBXRADIOBUTTONS.INIT (VAR BOUNDS:TRECT;ASTRINGS:PSITEM);BEGIN INHERITED INIT(BOUNDS , ASTRINGS );LLABEL :=
  340. NIL ;ID := 0 ;EDITFLAGS := 0 ;EVENTMASK := EVENTMASK OR EVBROADCAST ;END ;CONSTRUCTOR TBXRADIOBUTTONS.LOAD
  341. (VAR S:TSTREAM);BEGIN INHERITED LOAD(S );S.READ (ID , SIZEOF (BYTE ));GETPEERVIEWPTR (S , LLABEL );S.READ (EDITFLAGS ,
  342. SIZEOF (WORD ));END ;PROCEDURE TBXRADIOBUTTONS.ADDLABEL (ALABEL:PLABEL);BEGIN LLABEL := ALABEL ;END ;
  343. FUNCTION TBXRADIOBUTTONS.GETFIELDNAME :STRING ;VAR OI111IlIOOl0:STRING ;BEGIN IF (LLABEL <> NIL )THEN BEGIN OI111IlIOOl0
  344. := PLABEL (LLABEL )^. TEXT ^;STRIP (OI111IlIOOl0 , [ '~'] );END ELSE OI111IlIOOl0 := '';GETFIELDNAME := OI111IlIOOl0 ;
  345. END ;FUNCTION TBXRADIOBUTTONS.GETID :WORD ;BEGIN GETID := ID ;END ;PROCEDURE TBXRADIOBUTTONS.HANDLEEVENT
  346. (VAR EVENT:TEVENT);BEGIN INHERITED HANDLEEVENT(EVENT );CASE EVENT.WHAT  OF EVBROADCAST :BEGIN CASE EVENT.COMMAND
  347.  OF CMSETID :BEGIN SETID (EVENT.INFOWORD );CLEAREVENT (EVENT );EVENT.INFOPTR := @ SELF ;END ;CMIDENTIFY :IF
  348. (EVENT.INFOWORD =ID )THEN BEGIN CLEAREVENT (EVENT );EVENT.INFOPTR := @ SELF ;END ;END ;END ;END ;END ;
  349. PROCEDURE TBXRADIOBUTTONS.LOCK ;BEGIN SETSTATE (SFDISABLED , TRUE );END ;PROCEDURE TBXRADIOBUTTONS.SETEDITFLAG
  350. (AFLAG:WORD;ENABLE:BOOLEAN);BEGIN IF ENABLE THEN EDITFLAGS := EDITFLAGS OR AFLAG ELSE EDITFLAGS := EDITFLAGS AND NOT
  351. AFLAG ;END ;PROCEDURE TBXRADIOBUTTONS.SETID (AFIELDID:WORD);BEGIN ID := AFIELDID ;END ;
  352. PROCEDURE TBXRADIOBUTTONS.SETSTATE (ASTATE:WORD;ENABLE:BOOLEAN);BEGIN INHERITED SETSTATE(ASTATE , ENABLE );IF (ASTATE AND
  353. SFDISABLED <> 0 )THEN IF (LLABEL <> NIL )THEN LLABEL ^. SETSTATE (SFDISABLED , ENABLE );END ;
  354. PROCEDURE TBXRADIOBUTTONS.STORE (VAR S:TSTREAM);BEGIN INHERITED STORE(S );S.WRITE (ID , SIZEOF (BYTE ));PUTPEERVIEWPTR (S
  355. , LLABEL );S.WRITE (EDITFLAGS , SIZEOF (WORD ));END ;PROCEDURE TBXRADIOBUTTONS.UNLOCK ;BEGIN SETSTATE (SFDISABLED , FALSE
  356. );END ;CONSTRUCTOR TBXSLIDER.INIT (VAR BOUNDS:TRECT;AMIN:INTEGER;AMAX:INTEGER;CONST AMINLABEL:STRING ;
  357. CONST AMAXLABEL:STRING );VAR OO1I:TRECT;OO10:PVIEW;BEGIN INHERITED INIT(BOUNDS );EVENTMASK := EVENTMASK OR EVBROADCAST ;
  358. OPTIONS := OPTIONS OR OFFIRSTCLICK ;LLABEL := NIL ;ID := 0 ;EDITFLAGS := 0 ;OO1I.ASSIGN (0 , 0 , SIZE.X , SIZE.Y );OO10
  359. := NEW (PSTATICTEXT , INIT (OO1I , ' '));IF (APPLICATION ^. VALIDVIEW (OO10 )=NIL )THEN FAIL ;INSERT (OO10 );IF
  360. (AMINLABEL <> '')OR (AMAXLABEL <> '')THEN OO1I.ASSIGN (0 , 1 , SIZE.X , SIZE.Y )ELSE OO1I.ASSIGN (0 , 0 , SIZE.X , SIZE.Y
  361. );SCROLLBAR := NEW (PSCROLLBAR , INIT (OO1I ));SCROLLBAR ^. OPTIONS := SCROLLBAR ^. OPTIONS OR OFSELECTABLE ;IF
  362. (APPLICATION ^. VALIDVIEW (SCROLLBAR )=NIL )THEN FAIL ;INSERT (SCROLLBAR );SCROLLBAR ^. SETRANGE (AMIN , AMAX );IF
  363. (AMINLABEL <> '')THEN BEGIN OO1I.ASSIGN (0 , 0 , LENGTH (AMINLABEL ), 1 );OO10 := NEW (PSTATICTEXT , INIT (OO1I ,
  364. AMINLABEL ));IF (APPLICATION ^. VALIDVIEW (OO10 )=NIL )THEN FAIL ;INSERT (OO10 );END ;IF (AMAXLABEL <> '')THEN
  365. BEGIN OO1I.ASSIGN (SIZE.X - LENGTH (AMAXLABEL ), 0 , SIZE.X , 1 );OO10 := NEW (PSTATICTEXT , INIT (OO1I , AMAXLABEL ));
  366. IF (APPLICATION ^. VALIDVIEW (OO10 )=NIL )THEN FAIL ;INSERT (OO10 );END ;END ;CONSTRUCTOR TBXSLIDER.LOAD (VAR S:TSTREAM);
  367. BEGIN INHERITED LOAD(S );GETSUBVIEWPTR (S , SCROLLBAR );S.READ (ID , SIZEOF (BYTE ));GETPEERVIEWPTR (S , LLABEL );S.READ
  368. (EDITFLAGS , SIZEOF (WORD ));END ;PROCEDURE TBXSLIDER.ADDLABEL (ALABEL:PLABEL);BEGIN LLABEL := ALABEL ;END ;
  369. PROCEDURE TBXSLIDER.GETDATA (VAR REC);BEGIN INTEGER (REC ):= SCROLLBAR ^. VALUE ;END ;FUNCTION TBXSLIDER.GETFIELDNAME
  370. :STRING ;VAR OI111IlIOOl0:STRING ;BEGIN IF (LLABEL <> NIL )THEN BEGIN OI111IlIOOl0 := PLABEL (LLABEL )^. TEXT ^;STRIP
  371. (OI111IlIOOl0 , [ '~'] );END ELSE OI111IlIOOl0 := '';GETFIELDNAME := OI111IlIOOl0 ;END ;FUNCTION TBXSLIDER.GETID :WORD ;
  372. BEGIN GETID := ID ;END ;PROCEDURE TBXSLIDER.HANDLEEVENT (VAR EVENT:TEVENT);FUNCTION OI1IIO0lOOO1 (OO10:PVIEW):BOOLEAN ;
  373. FAR ;BEGIN OI1IIO0lOOO1 := (OO10 ^. STATE AND SFVISIBLE <> 0 )AND OO10 ^. MOUSEINVIEW (EVENT.WHERE );END ;BEGIN IF
  374. (EVENT.WHAT =EVBROADCAST )THEN BEGIN CASE EVENT.COMMAND  OF CMSETID :BEGIN SETID (EVENT.INFOWORD );CLEAREVENT (EVENT );
  375. EVENT.INFOPTR := @ SELF ;END ;CMIDENTIFY :IF (EVENT.INFOWORD =ID )THEN BEGIN CLEAREVENT (EVENT );EVENT.INFOPTR := @ SELF
  376. ;END ;END ;END ELSE IF (EVENT.WHAT AND POSITIONALEVENTS <> 0 )THEN BEGIN IF (FIRSTTHAT (@ OI1IIO0lOOO1 )<> LAST )THEN
  377. INHERITED HANDLEEVENT(EVENT )ELSE CLEAREVENT (EVENT );END ELSE INHERITED HANDLEEVENT(EVENT )END ;
  378. PROCEDURE TBXSLIDER.LOCK ;BEGIN SETSTATE (SFDISABLED , TRUE );END ;PROCEDURE TBXSLIDER.SETDATA (VAR REC);BEGIN IF
  379. (INTEGER (REC )<> SCROLLBAR ^. VALUE )THEN SCROLLBAR ^. SETVALUE (INTEGER (REC ));END ;PROCEDURE TBXSLIDER.SETEDITFLAG
  380. (AFLAG:WORD;ENABLE:BOOLEAN);BEGIN IF ENABLE THEN EDITFLAGS := EDITFLAGS OR AFLAG ELSE EDITFLAGS := EDITFLAGS AND NOT
  381. AFLAG ;END ;PROCEDURE TBXSLIDER.SETID (AFIELDID:WORD);BEGIN ID := AFIELDID ;END ;PROCEDURE TBXSLIDER.SETSTATE
  382. (ASTATE:WORD;ENABLE:BOOLEAN);BEGIN INHERITED SETSTATE(ASTATE , ENABLE );IF (ASTATE AND SFDISABLED <> 0 )THEN
  383. BEGIN SCROLLBAR ^. SETSTATE (SFDISABLED , ENABLE );IF (LLABEL <> NIL )THEN LLABEL ^. SETSTATE (SFDISABLED , ENABLE );
  384. END ;END ;PROCEDURE TBXSLIDER.STORE (VAR S:TSTREAM);BEGIN INHERITED STORE(S );PUTSUBVIEWPTR (S , SCROLLBAR );S.WRITE (ID
  385. , SIZEOF (BYTE ));PUTPEERVIEWPTR (S , LLABEL );S.WRITE (EDITFLAGS , SIZEOF (WORD ));END ;PROCEDURE TBXSLIDER.UNLOCK ;
  386. BEGIN SETSTATE (SFDISABLED , FALSE );END ;CONSTRUCTOR TBXSPINBAR.INIT (VAR BOUNDS:TRECT);
  387. CONST O10OO0I0Ill1I:TBXSPINCHARS=(#30, #31);O10OO0I0IlO0I:TBXSPINCHARS=(#17, #16);BEGIN INHERITED INIT(BOUNDS );OPTIONS
  388. := OPTIONS OR OFFIRSTCLICK ;IF SIZE.X =1 THEN CHARS := O10OO0I0Ill1I ELSE CHARS := O10OO0I0IlO0I ;END ;
  389. CONSTRUCTOR TBXSPINBAR.LOAD (VAR S:TSTREAM);BEGIN INHERITED LOAD(S );S.READ (CHARS , 2 * SIZEOF (CHAR ));END ;
  390. PROCEDURE TBXSPINBAR.DRAW ;VAR OIO1:TDRAWBUFFER;BEGIN MOVECHAR (OIO1 [ 0 ] , CHARS [ 1 ] , GETCOLOR (2 ), 1 );MOVECHAR
  391. (OIO1 [ 1 ] , CHARS [ 2 ] , GETCOLOR (2 ), 1 );WRITEBUF (0 , 0 , SIZE.X , SIZE.Y , OIO1 );END ;
  392. PROCEDURE TBXSPINBAR.HANDLEEVENT (VAR EVENT:TEVENT);VAR OI1I1O1lll10:TPOINT;OOIO:INTEGER;BEGIN TVIEW.HANDLEEVENT (EVENT
  393. );CASE EVENT.WHAT  OF EVMOUSEDOWN :BEGIN SPINEDIT ^. GETDATA (OOIO );IF (OOIO < MIN )THEN OOIO := MIN ELSE IF (OOIO > MAX
  394. )THEN OOIO := MAX ;IF (VALUE <> OOIO )THEN VALUE := OOIO ;REPEAT MAKELOCAL (EVENT.WHERE , OI1I1O1lll10 );OOIO := 0 ;IF
  395. (SIZE.X =1 )THEN BEGIN IF (OI1I1O1lll10.Y =0 )THEN OOIO := ARSTEP ELSE IF (OI1I1O1lll10.Y =1 )THEN OOIO := - ARSTEP ;
  396. END ELSE IF (SIZE.Y =1 )THEN BEGIN IF (OI1I1O1lll10.X =1 )THEN OOIO := ARSTEP ELSE IF (OI1I1O1lll10.X =0 )THEN OOIO := -
  397. ARSTEP ;END ;IF (OOIO <> 0 )THEN SETVALUE (VALUE + OOIO );UNTIL NOT MOUSEEVENT (EVENT , EVMOUSEAUTO )OR NOT MOUSEINVIEW
  398. (EVENT.WHERE );CLEAREVENT (EVENT );END ;END ;END ;PROCEDURE TBXSPINBAR.STORE (VAR S:TSTREAM);BEGIN INHERITED STORE(S );
  399. S.WRITE (CHARS , 2 * SIZEOF (CHAR ));END ;CONSTRUCTOR TBXSPINEDIT.INIT (VAR BOUNDS:TRECT;CONST AMASK:STRING ;
  400. ASPINBAR:PBXSPINBAR);BEGIN IF (ASPINBAR =NIL )THEN FAIL ;INHERITED INIT(BOUNDS , AMASK , ASPINBAR ^. MIN , ASPINBAR ^.
  401. MAX );SPINBAR := ASPINBAR ;EVENTMASK := EVENTMASK OR EVBROADCAST ;OPTIONS := OPTIONS OR OFVALIDATE ;
  402. INHERITED SETDATA(SPINBAR ^. VALUE );SPINBAR ^. SPINEDIT := @ SELF ;END ;CONSTRUCTOR TBXSPINEDIT.LOAD (VAR S:TSTREAM);
  403. BEGIN INHERITED LOAD(S );GETPEERVIEWPTR (S , SPINBAR );END ;PROCEDURE TBXSPINEDIT.HANDLEEVENT (VAR EVENT:TEVENT);
  404. BEGIN IF (EVENT.WHAT =EVBROADCAST )THEN BEGIN CASE EVENT.COMMAND  OF CMSCROLLBARCHANGED :IF (EVENT.INFOPTR =SPINBAR )THEN
  405. SETDATA (SPINBAR ^. VALUE );END ;END ;INHERITED HANDLEEVENT(EVENT );END ;PROCEDURE TBXSPINEDIT.SETDATA (VAR REC);
  406. VAR OOIO:INTEGER;BEGIN GETDATA (OOIO );IF (INTEGER (REC )<> OOIO )THEN BEGIN INHERITED SETDATA(REC );SPINBAR ^. SETVALUE
  407. (INTEGER (REC ));END ;END ;PROCEDURE TBXSPINEDIT.SETSTATE (ASTATE:WORD;ENABLE:BOOLEAN);BEGIN INHERITED SETSTATE(ASTATE ,
  408. ENABLE );IF (ASTATE AND SFDISABLED <> 0 )THEN SPINBAR ^. SETSTATE (SFDISABLED , ENABLE );END ;
  409. PROCEDURE TBXSPINEDIT.STORE (VAR S:TSTREAM);BEGIN INHERITED STORE(S );PUTPEERVIEWPTR (S , SPINBAR );END ;
  410. FUNCTION TBXSPINEDIT.VALID (COMMAND:WORD):BOOLEAN ;VAR OOIO:INTEGER;BEGIN GETDATA (OOIO );IF (OOIO < SPINBAR ^. MIN )THEN
  411. BEGIN OOIO := SPINBAR ^. MIN ;VALID := FALSE ;END ELSE IF (OOIO > SPINBAR ^. MAX )THEN BEGIN OOIO := SPINBAR ^. MAX ;
  412. VALID := FALSE ;END ELSE BEGIN VALID := TRUE ;END ;SETDATA (OOIO );END ;CONSTRUCTOR TBXENTRYDIALOG.INIT
  413. (VAR BOUNDS:TRECT;ATITLE:TTITLESTR);BEGIN INHERITED INIT(BOUNDS , ATITLE );EVENTMASK := EVENTMASK OR EVBROADCAST ;NEXTID
  414. := 0 ;END ;CONSTRUCTOR TBXENTRYDIALOG.LOAD (VAR S:TSTREAM);BEGIN INHERITED LOAD(S );S.READ (NEXTID , SIZEOF (WORD ));
  415. END ;FUNCTION TBXENTRYDIALOG.FINDFIELD (ID:WORD):POINTER ;FUNCTION OII0IIlOIl (OO10:PVIEW):BOOLEAN ;FAR ;
  416. VAR OIOO0l010lO:TEVENT;BEGIN OIOO0l010lO.WHAT := EVBROADCAST ;OIOO0l010lO.COMMAND := CMIDENTIFY ;OIOO0l010lO.INFOWORD :=
  417. ID ;OO10 ^. HANDLEEVENT (OIOO0l010lO );OII0IIlOIl := (OIOO0l010lO.WHAT =EVNOTHING );END ;BEGIN FINDFIELD := FIRSTTHAT (@
  418. OII0IIlOIl );END ;PROCEDURE TBXENTRYDIALOG.HANDLEEVENT (VAR EVENT:TEVENT);BEGIN INHERITED HANDLEEVENT(EVENT );IF
  419. (EVENT.WHAT =EVBROADCAST )THEN IF (EVENT.COMMAND =CMFIELDERROR )THEN BEGIN MESSAGEBOX (PSTRING (EVENT.INFOPTR )^, NIL ,
  420. MFERROR + MFOKBUTTON );CLEAREVENT (EVENT );END ;END ;PROCEDURE TBXENTRYDIALOG.INSERT (P:PVIEW);VAR OIOO0l010lO:TEVENT;
  421. BEGIN INHERITED INSERT(P );CLEAREVENT (OIOO0l010lO );OIOO0l010lO.WHAT := EVBROADCAST ;OIOO0l010lO.COMMAND := CMSETID ;
  422. OIOO0l010lO.INFOWORD := NEXTID + 1 ;P ^. HANDLEEVENT (OIOO0l010lO );IF (OIOO0l010lO.INFOPTR <> NIL )THEN INC (NEXTID );
  423. END ;PROCEDURE TBXENTRYDIALOG.LOCKFIELD (ID:WORD;ENABLE:BOOLEAN);VAR OO10:PVIEW;BEGIN OO10 := FINDFIELD (ID );IF (OO10 <>
  424. NIL )THEN OO10 ^. SETSTATE (SFDISABLED , ENABLE );END ;PROCEDURE TBXENTRYDIALOG.STORE (VAR S:TSTREAM);
  425. BEGIN INHERITED STORE(S );S.WRITE (NEXTID , SIZEOF (WORD ));END ;PROCEDURE REGISTERTVINPUT ;BEGIN REGISTERTYPE
  426. (RBXEDITLINE );REGISTERTYPE (RBXDATEEDIT );REGISTERTYPE (RBXLONGEDIT );REGISTERTYPE (RBXHEXEDIT );REGISTERTYPE
  427. (RBXINTEGEREDIT );REGISTERTYPE (RBXWORDEDIT );REGISTERTYPE (RBXBYTEEDIT );{$IFOPT N+} REGISTERTYPE (RBXDOUBLEEDIT );
  428. {$ENDIF} REGISTERTYPE (RBXREALEDIT );REGISTERTYPE (RBXRADIOBUTTONS );REGISTERTYPE (RBXCHECKBOXES );REGISTERTYPE
  429. (RBXENTRYDIALOG );REGISTERTYPE (RBXSLIDER );REGISTERTYPE (RBXSPINBAR );REGISTERTYPE (RBXSPINEDIT );END ;END .
  430.